home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / sbp3_1e.lzh / REALSQRT.PL < prev    next >
Text File  |  1991-10-31  |  1KB  |  48 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7. /* REALSQRT.PL */
  8.  
  9. /*
  10.  * Succeeds if second parameter is (approximately)
  11.  * a real square root of the first parameter.
  12.  *
  13.  * Preserves nondeterminism and interchangeability
  14.  * of unknowns -- see text.
  15.  */
  16.  
  17. /* load math library */
  18. :- ensure_loaded(library(math)).
  19.  
  20. close_enough(X,X) :- !.
  21.  
  22. close_enough(X,Y) :- X < Y,
  23.                      Diff is Y-X,
  24.                      Diff < 0.0001.
  25.  
  26. close_enough(X,Y) :- Y < X,
  27.                      close_enough(Y,X).
  28.  
  29.  
  30. real_square_root(X,nonexistent) :- X < 0.
  31.  
  32. real_square_root(X,Y) :- number(X),
  33.                          var(Y),
  34.                          X >= 0.0,
  35.                          sqrt(X,R), /* sqrt(Argument,Result) */
  36.                          close_enough(R,Y).
  37.  
  38. real_square_root(X,Y) :- number(X),
  39.                          var(Y),
  40.                          X >= 0.0,
  41.                          sqrt(X,R1),
  42.              R is -R1, /* negative root */
  43.                          close_enough(R,Y).
  44.  
  45. real_square_root(X,Y) :- number(Y),
  46.                          Ysquared is Y*Y,
  47.                          close_enough(Ysquared,X).
  48.